home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 41 / Amiga Format CD41 (1999-06)(Future Publishing)(GB)[!][issue 1999-07].iso / -seriously_amiga- / programming / other / scm / slib / scaoutp.scm < prev    next >
Text File  |  1999-04-19  |  3KB  |  94 lines
  1. ;;; "scaoutp.scm" syntax-case output
  2. ;;; Copyright (C) 1992 R. Kent Dybvig
  3. ;;;
  4. ;;; Permission to copy this software, in whole or in part, to use this
  5. ;;; software for any lawful purpose, and to redistribute this software
  6. ;;; is granted subject to the restriction that all copies made of this
  7. ;;; software must include this copyright notice in full.  This software
  8. ;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
  9. ;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
  10. ;;; OR FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
  11. ;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
  12. ;;; NATURE WHATSOEVER.
  13.  
  14. ;;; Written by Robert Hieb & Kent Dybvig
  15.  
  16. ;;; This file was munged by a simple minded sed script since it left
  17. ;;; its original authors' hands.  See syncase.sh for the horrid details.
  18.  
  19. ;;; output.ss
  20. ;;; Robert Hieb & Kent Dybvig
  21. ;;; 92/06/18
  22.  
  23. ; The output routines can be tailored to feed a specific system or compiler.
  24. ; They are set up here to generate the following subset of standard Scheme:
  25.  
  26. ;  <expression> :== <application>
  27. ;                |  <variable>
  28. ;                |  (set! <variable> <expression>)
  29. ;                |  (define <variable> <expression>)
  30. ;                |  (lambda (<variable>*) <expression>)
  31. ;                |  (lambda <variable> <expression>)
  32. ;                |  (lambda (<variable>+ . <variable>) <expression>)
  33. ;                |  (letrec (<binding>+) <expression>)
  34. ;                |  (if <expression> <expression> <expression>)
  35. ;                |  (begin <expression> <expression>)
  36. ;                |  (quote <datum>)
  37. ; <application> :== (<expression>+)
  38. ;     <binding> :== (<variable> <expression>)
  39. ;    <variable> :== <symbol>
  40.  
  41. ; Definitions are generated only at top level.
  42.  
  43. (define syncase:build-application
  44.    (lambda (fun-exp arg-exps)
  45.       `(,fun-exp ,@arg-exps)))
  46.  
  47. (define syncase:build-conditional
  48.    (lambda (test-exp then-exp else-exp)
  49.       `(if ,test-exp ,then-exp ,else-exp)))
  50.  
  51. (define syncase:build-lexical-reference (lambda (var) var))
  52.  
  53. (define syncase:build-lexical-assignment
  54.    (lambda (var exp)
  55.       `(set! ,var ,exp)))
  56.  
  57. (define syncase:build-global-reference (lambda (var) var))
  58.  
  59. (define syncase:build-global-assignment
  60.    (lambda (var exp)
  61.       `(set! ,var ,exp)))
  62.  
  63. (define syncase:build-lambda
  64.    (lambda (vars exp)
  65.       `(lambda ,vars ,exp)))
  66.  
  67. (define syncase:build-improper-lambda
  68.    (lambda (vars var exp)
  69.       `(lambda (,@vars . ,var) ,exp)))
  70.  
  71. (define syncase:build-data
  72.    (lambda (exp)
  73.       `(quote ,exp)))
  74.  
  75. (define syncase:build-identifier
  76.    (lambda (id)
  77.       `(quote ,id)))
  78.  
  79. (define syncase:build-sequence
  80.    (lambda (exps)
  81.       (if (null? (cdr exps))
  82.           (car exps)
  83.           `(begin ,(car exps) ,(syncase:build-sequence (cdr exps))))))
  84.  
  85. (define syncase:build-letrec
  86.    (lambda (vars val-exps body-exp)
  87.       (if (null? vars)
  88.           body-exp
  89.           `(letrec ,(map list vars val-exps) ,body-exp))))
  90.  
  91. (define syncase:build-global-definition
  92.    (lambda (var val)
  93.       `(define ,var ,val)))
  94.